home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / make-docfile.el.z / make-docfile.el
Encoding:
Text File  |  1998-05-21  |  6.1 KB  |  196 lines
  1. ;;; make-docfile.el --- Cache docstrings in external file
  2.  
  3. ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Unknown
  6. ;; Maintainer: Steven L Baur <steve@altair.xemacs.org>
  7. ;; Keywords: internal
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: Not in FSF
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; This is a front-end to the make-docfile program that gathers up all the
  31. ;; lisp files that will be dumped with XEmacs.  It would probably be best
  32. ;; to just move make-docfile.c completely to lisp and be done with it.
  33.  
  34. ;;; Code:
  35.  
  36. (defvar options nil)
  37. (defvar processed nil)
  38. (defvar docfile nil)
  39. (defvar docfile-buffer nil)
  40. (defvar site-file-list nil)
  41. (defvar docfile-out-of-date nil)
  42.  
  43. ;; Gobble up the stuff we don't wish to pass on.
  44. (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
  45.  
  46. ;; First gather up the command line options.
  47. (let (done)
  48.   (while (and (null done) command-line-args)
  49.     (let ((arg (car command-line-args)))
  50.       (cond ((or (string-equal arg "-o") ; Specify DOC file name
  51.          (string-equal arg "-a") ; Append to DOC file
  52.          (string-equal arg "-d")) ; Set working directory
  53.          (if (string-equal arg "-o")
  54.          (setq docfile (car (cdr command-line-args))))
  55.          (setq options (cons arg options))
  56.          (setq options (cons (car (cdr command-line-args)) options)))
  57.         ((string-equal arg "-i") ; Set site files to scan
  58.          (setq site-file-list (car (cdr command-line-args))))
  59.         (t (setq done t)))
  60.       (if (null done)
  61.       (setq command-line-args (cdr (cdr command-line-args)))))))
  62. (setq options (nreverse options))
  63.  
  64. ;; (print (concat "Options: " (prin1-to-string options)))
  65.  
  66. ;; Next process the list of C files.
  67. (while command-line-args
  68.   (let ((arg (car command-line-args)))
  69.     (if (null (member arg processed))
  70.     (progn
  71.       (if (and (null docfile-out-of-date)
  72.            (file-newer-than-file-p arg docfile))
  73.           (setq docfile-out-of-date t))
  74.       (setq processed (cons arg processed)))))
  75.   (setq command-line-args (cdr command-line-args)))
  76.  
  77. ;; Then process the list of Lisp files.
  78. (define-function 'defalias 'define-function)
  79. (let ((temp-path (expand-file-name ".." (car load-path))))
  80.   (setq load-path (nconc (mapcar
  81.               #'(lambda (i) (concat i "/"))
  82.               (directory-files temp-path t "^[^-.]"
  83.                        nil 'dirs-only))
  84.              (cons temp-path load-path))))
  85.  
  86. ;; Then process the autoloads
  87. (setq autoload-file-name "auto-autoloads.elc")
  88. (setq source-directory (concat default-directory "../lisp"))
  89. ;; (print (concat "Source directory: " source-directory))
  90. (require 'packages)
  91.  
  92. ;; We must have some lisp support at this point
  93.  
  94. ;(load "backquote")
  95. ;(load "bytecomp-runtime")
  96. ;(load "subr")
  97. ;(load "replace")
  98. ;(load "version.el")
  99. ;(load "cl")
  100.  
  101. ;; (load "featurep")
  102.  
  103. (let (preloaded-file-list)
  104.  (load (concat default-directory "../lisp/prim/dumped-lisp.el"))
  105.  (setq preloaded-file-list
  106.        (append preloaded-file-list packages-hardcoded-lisp))
  107.  (while preloaded-file-list
  108.    (let ((arg0 (packages-add-suffix (car preloaded-file-list)))
  109.      arg)
  110.      (setq arg (locate-library arg0))
  111.      (if (null arg)
  112.      (princ (format "Error:  dumped file %s does not exist\n" arg))
  113.        (if (null (member arg processed))
  114.        (progn
  115.          (if (and (null docfile-out-of-date)
  116.               (file-newer-than-file-p arg docfile))
  117.          (setq docfile-out-of-date t))
  118.          (setq processed (cons arg processed)))))
  119.      (setq preloaded-file-list (cdr preloaded-file-list)))))
  120.  
  121. ;; Finally process the list of site-loaded files.
  122. (if site-file-list
  123.     (let (site-load-packages)
  124.       (load site-file-list t t)
  125.       (while site-load-packages
  126.     (let ((arg (car site-load-packages)))
  127.       (if (null (member arg processed))
  128.           (progn
  129.         (if (and (null docfile-out-of-date)
  130.              (file-newer-than-file-p arg docfile))
  131.             (setq docfile-out-of-date t))
  132.         (setq processed (cons arg processed)))))
  133.     (setq site-load-packages (cdr site-load-packages)))))
  134.  
  135. (packages-find-packages package-path t)
  136.  
  137. (let ((autoloads (list-autoloads-path)))
  138.   ;; (print (concat "Autoloads: " (prin1-to-string autoloads)))
  139.   (while autoloads
  140.     (let ((arg (car autoloads)))
  141.       (if (null (member arg processed))
  142.       (progn
  143.         ;; (print arg)
  144.         (if (and (null docfile-out-of-date)
  145.              (file-newer-than-file-p arg docfile))
  146.         (setq docfile-out-of-date t))
  147.         (setq processed (cons arg processed))))
  148.       (setq autoloads (cdr autoloads)))))
  149.  
  150. ;; Now fire up make-docfile and we're done
  151.  
  152. (setq processed (nreverse processed))
  153.  
  154. ;; (print (prin1-to-string (append options processed)))
  155.  
  156. (if docfile-out-of-date
  157.     (progn
  158.       (princ "Spawning make-docfile ...")
  159.       ;; (print (prin1-to-string (append options processed)))
  160.  
  161.       (setq exec-path (list (concat default-directory "../lib-src")))
  162.  
  163.       ;; (locate-file-clear-hashing nil)
  164.       (if (memq system-type '(berkeley-unix next-mach))
  165.       ;; Suboptimal, but we have a unresolved bug somewhere in the
  166.       ;; low-level process code
  167.       (call-process-internal
  168.        "/bin/csh"
  169.        nil
  170.        t
  171.        nil
  172.        "-fc"
  173.        (mapconcat
  174.         'identity
  175.         (append
  176.          (list (concat default-directory "../lib-src/make-docfile"))
  177.          options processed)
  178.         " "))
  179.     ;; (print (prin1-to-string (append options processed)))
  180.     (apply 'call-process-internal
  181.            ;; (concat default-directory "../lib-src/make-docfile")
  182.            "make-docfile"
  183.            nil
  184.            t
  185.            nil
  186.            (append options processed)))
  187.  
  188.       (princ "Spawning make-docfile ...done\n")
  189.       ;; (write-region-internal (point-min) (point-max) "/tmp/DOC")
  190.       )
  191.   (princ "DOC file is up to date\n"))
  192.  
  193. (kill-emacs)
  194.  
  195. ;;; make-docfile.el ends here
  196.